home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / MULTIPRI.M < prev    next >
Encoding:
Text File  |  1989-06-18  |  6.4 KB  |  231 lines
  1. MODULE MultiPrint;
  2.  
  3. (* Listet Text-Dateien.
  4.  * 2 oder 3 Parameter beim Aufruf:
  5.  *    - Ordnername mit Datei-Wildcard für Auswahl der Dateien, z.B. "D:*.TXT"
  6.  *    - Ausgabedateiname, z.B. "PRN:"
  7.  *    - Wahlweise '@': Alle Texte sind Def-Module, Überschrift wird gedruckt.
  8.  *)
  9.  
  10. IMPORT GEMDOSIO;
  11. FROM InOut IMPORT WritePg, WriteString, Write, Read, FlushKbd, WriteLn,
  12. KeyPressed;
  13.  
  14. FROM Strings IMPORT String, Concat, Split, Delete, PosLen, Space, Length,
  15.                 Compare, Relation;
  16.  
  17. FROM Directory IMPORT FileAttrSet, DirEntry, DirQuery;
  18.  
  19. FROM ArgCV IMPORT InitArgCV, PtrArgStr, ArgStr;
  20.  
  21. FROM Files IMPORT ResetState, State, Access, File, Open, Close, Create, replaceOld, EOF;
  22.  
  23. FROM Text IMPORT EOL;
  24. IMPORT Text;
  25.  
  26. FROM StrConv IMPORT CardToStr;
  27.  
  28.  
  29.  
  30. CONST   Lines = 62;
  31.         Columns = 80;
  32.         head1 = 'B.';
  33.         head2 = 'Anhang';
  34.         head3 = head1 + " " + head2;
  35.         
  36.         ESC          = 33C;
  37.         FF           = 14C;
  38.         TAB          = 11C;
  39.         UnderlineOn  = (* Brother: *) '&dD';
  40.         UnderlineOff = (* Brother: *) '&d@';
  41.  
  42. VAR Pages: CARDINAL;
  43.  
  44. PROCEDURE Text_Write (f: File; s: CHAR);
  45.   (*
  46.    * Mit Timeout-Erkennung
  47.    *)
  48.   VAR ch: CHAR; l: LONGCARD;
  49.   BEGIN
  50.     LOOP
  51.       Text.Write (f, s);
  52.       IF State (f) < 0 THEN
  53.         ResetState (f);
  54.         l:= 0;
  55.         LOOP
  56.           INC (l);
  57.           IF l = 20000 THEN
  58.             EXIT
  59.           END
  60.         END;
  61.         (*
  62.         Write (CHR (7));
  63.         WriteLn;
  64.         WriteLn;
  65.         WriteString ("*** Timeout ***");
  66.         WriteLn;
  67.         WriteLn;
  68.         WriteString ('Taste zum weiterdrucken...');
  69.         FlushKbd();
  70.         l:= 0;
  71.         LOOP
  72.           IF KeyPressed () THEN EXIT END;
  73.           INC (l);
  74.           IF l = 4000 THEN
  75.             Write (CHR (7));
  76.             l:= 0
  77.           END
  78.         END;
  79.         Read (ch);
  80.         WriteLn;
  81.         *)
  82.       ELSE
  83.         EXIT
  84.       END
  85.     END
  86.   END Text_Write;
  87.  
  88. PROCEDURE Text_WriteString (f: File; REF s: ARRAY OF CHAR);
  89.   VAR i: CARDINAL;
  90.   BEGIN
  91.     FOR i:= 0 TO HIGH (s) DO
  92.       IF s[i] = 0C THEN RETURN END;
  93.       Text_Write (f, s[i]);
  94.     END;
  95.   END Text_WriteString;
  96.  
  97. PROCEDURE Text_WriteLn (f: File);
  98.   BEGIN
  99.     Text_Write (f, CHR(13));
  100.     Text_Write (f, CHR(10));
  101.   END Text_WriteLn;
  102.  
  103.  
  104. VAR printer: File;
  105.     defMod : BOOLEAN;
  106.  
  107. PROCEDURE print ( REF path: ARRAY OF CHAR; dir: DirEntry ): BOOLEAN;
  108.   
  109.   VAR txt: File; c: CHAR; s,l,l2: String; ok: BOOLEAN; line: CARDINAL;
  110.   
  111.   BEGIN
  112.     WriteLn;
  113.     WriteString (dir.name);
  114.     Concat ( path, dir.name, s, ok );
  115.     
  116.     IF defMod THEN
  117.       Open ( txt, s, readSeqTxt );
  118.       LOOP
  119.         Text.ReadString ( txt, l );
  120.         Text.ReadLn (txt);
  121.         Split ( l, 18, l2, l, ok );
  122.         IF Compare ( 'DEFINITION MODULE ', l2 ) = equal THEN
  123.           Delete ( l, PosLen (';',l,0), 99, ok );
  124.           EXIT
  125.         END;
  126.         IF EOF (txt) THEN
  127.           HALT; (* Kein Definitionsmodul !? *)
  128.           l:= '';
  129.           EXIT
  130.         END
  131.       END;
  132.       Close (txt)
  133.     END;
  134.     
  135.     line:= 0;
  136.     Open ( txt, s, readSeqTxt );
  137.     WHILE ~EOF (txt) DO
  138.       IF defMod & (line = 0) THEN (* Kopfzeile *)
  139.         Text_WriteLn (printer);
  140.         IF defMod THEN
  141.           Text_Write (printer, ESC);
  142.           (*
  143.             Text_Write (printer, "!");
  144.             Text_Write (printer, CHR(128));
  145.           *)
  146.           Text_WriteString (printer, UnderlineOn);
  147.           IF ODD (Pages) THEN
  148.             Text_WriteString (printer, head3);
  149.             Text_WriteString (printer, Space (Columns-LENGTH(head3)-LENGTH(l)));
  150.             Text_WriteString (printer, l);  (* Modulname *)
  151.           ELSE
  152.             Text_WriteString (printer, l);  (* Modulname *)
  153.             Text_WriteString (printer, Space (Columns-LENGTH(head3)-LENGTH(l)));
  154.             Text_WriteString (printer, head3);
  155.           END;
  156.           Text_Write (printer, ESC);
  157.           Text_WriteString (printer, UnderlineOff);
  158.           (*
  159.             Text_Write (printer, "!");
  160.             Text_Write (printer, CHR(0));
  161.           *)
  162.           
  163.           (*
  164.           Text_WriteString (printer, head1);
  165.           Text_Write (printer, TAB);
  166.           Text_WriteString (printer, l);  (* Modulname *)
  167.           Text_WriteString (printer, Space (20-Length (l)));
  168.           Text_Write (printer, TAB);
  169.           Text_WriteString (printer, head2);
  170.           *)
  171.           Text_WriteLn (printer);
  172.           Text_WriteLn (printer);
  173.           Text_WriteLn (printer);
  174.           line:= 4
  175.         ELSE
  176.           line:= 1
  177.         END;
  178.       END;
  179.       Text.Read (txt, c);
  180.       IF EOL (txt) & ~EOF (txt) THEN
  181.         INC (line);
  182.         IF defMod & (line > Lines) THEN
  183.           INC (Pages);
  184.           Text_Write (printer, FF);
  185.           line:= 0
  186.         ELSE
  187.           Text_WriteLn (printer)
  188.         END
  189.       ELSE
  190.         IF c='ß' (* sz *) THEN c:= CHR (225) (* beta *) END;
  191.         Text_Write (printer, c)
  192.       END
  193.     END;
  194.     Close (txt);
  195.     Text_Write (printer, FF);
  196.     INC (Pages);
  197.     
  198.     RETURN TRUE
  199.   END print;
  200.  
  201.  
  202. VAR argc: CARDINAL;
  203.     argv: ARRAY [0..3] OF PtrArgStr;
  204.     err: INTEGER;
  205.     inname, prname, dummy: String;
  206.  
  207. BEGIN
  208.   Pages:= 1;
  209.   WritePg;
  210.   (*
  211.   InitArgCV (argc, argv);
  212.   defMod:= argv[3]^[0] = '@';
  213.   *)
  214.   defMod:= TRUE;
  215.   inname:= 'c:\d\*.d';
  216.   prname:= 'prn:';
  217.   Create ( printer, prname, writeSeqTxt, replaceOld );
  218.   (* Init. f. Laserjet:
  219.   *)
  220.   Text_Write (printer, ESC); Text_WriteString (printer, '&l0L');
  221.   (* Fettschrift Laserjet: *)
  222.   Text_Write (printer, ESC); Text_Write (printer, "E");
  223.   DirQuery ( inname, FileAttrSet {}, print, err );
  224.   Close ( printer );
  225.   WriteLn;
  226.   WriteString ('Total pages: ');
  227.   WriteString (CardToStr (Pages, 0));
  228. END MultiPrint.
  229. ə
  230. (* $FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$000005DE$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EB$FFF954EBÇ$000015B1T.......T.T.....T.......T.......T.......T.......T.......T.......T.......T.......$000006A7$000005C5$00000567$00000582$0000059E$00000796$000015B1$000015F9$0000052E$00000512$00000285$FFEBF4AA$00001618$0000070E$00000BF4$000005D1áÇÇ*)
  231.